New Star Software Collection/NSS_Collection.iso/3-004 ms visual basic pro 30/4.imz/4.IMA/ADDFIELD.FR_/ADDFIELD.bin

Text File | 1993-04-28 | 6KB | 222 lines

VERSION 2.00
Begin Form fAddField
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Add Field"
   ClientHeight    =   2055
   ClientLeft      =   3000
   ClientTop       =   3360
   ClientWidth     =   3450
   ControlBox      =   0   'False
   Height          =   2460
   Left            =   2940
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2040
   ScaleMode       =   0  'User
   ScaleWidth      =   3480
   Top             =   3015
   Width           =   3570
   Begin TextBox cFieldName
      BackColor       =   &H00FFFFFF&
      Height          =   288
      Left            =   840
      TabIndex        =   1
      Tag             =   "OL"
      Top             =   120
      Width           =   2532
   End
   Begin ComboBox cFieldType
      BackColor       =   &H00FFFFFF&
      Height          =   288
      Left            =   840
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Tag             =   "OL"
      Top             =   600
      Width           =   2532
   End
   Begin TextBox cFieldLength
      BackColor       =   &H00FFFFFF&
      Enabled         =   0   'False
      Height          =   288
      Left            =   840
      TabIndex        =   5
      Tag             =   "OL"
      Top             =   1080
      Width           =   732
   End
   Begin CommandButton OkayButton
      Caption         =   "&OK"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   372
      Left            =   360
      TabIndex        =   6
      Top             =   1560
      Width           =   1092
   End
   Begin CommandButton CancelButton
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   372
      Left            =   1920
      TabIndex        =   7
      Top             =   1560
      Width           =   1092
   End
   Begin Label FieldSizeLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Size:"
      Height          =   252
      Left            =   120
      TabIndex        =   3
      Top             =   1080
      Width           =   612
   End
   Begin Label FieldTypeLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Type:"
      Height          =   252
      Left            =   120
      TabIndex        =   2
      Top             =   600
      Width           =   612
   End
   Begin Label FieldNameLabel
      BackColor       =   &H00C0C0C0&
      Caption         =   "Name:"
      Height          =   252
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   612
   End
End

Option Explicit

Sub CancelButton_Click ()
  Unload Me
End Sub

Sub cFieldLength_Change ()
  'activate the ok button only if all of the
  'fields have something in it
  If cFieldName <> "" And cFieldType <> "" And Val(cFieldLength) > 0 Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub cFieldName_Change ()
  'activate the ok button only if all of the
  'fields have something in it
  If cFieldName <> "" And cFieldType <> "" And Val(cFieldLength) > 0 Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub cFieldType_Click ()
  'call function to set size and type of field
  cFieldLength = SetFldProperties(CStr(cFieldType))
  cFieldLength.Enabled = False

  'enable field length control for string and memo type
  If gwFldType = FT_STRING Then
    'allow entry of field length
    cFieldLength.Enabled = True
    cFieldLength = "0"
  End If

  'make sure that there is data in
  'all fields before enabling the ok button
  If cFieldName <> "" Then
    OkayButton.Enabled = True
  Else
    OkayButton.Enabled = False
  End If
End Sub

Sub Form_Load ()
  'populate the Field Type list on the form
  If gstDataType = "MS Access" Then
    cFieldType.AddItem "Counter"
  End If
  cFieldType.AddItem "True/False"
  cFieldType.AddItem "Byte"
  cFieldType.AddItem "Integer"
  cFieldType.AddItem "Long"
  cFieldType.AddItem "Currency"
  cFieldType.AddItem "Single"
  cFieldType.AddItem "Double"
  cFieldType.AddItem "Date/Time"
  cFieldType.AddItem "String"
  cFieldType.AddItem "Binary"
  cFieldType.AddItem "Memo"
End Sub

Sub Form_Paint ()
  Outlines Me
End Sub

Sub OkayButton_Click ()
  On Error GoTo OkayErr

  Dim f As New Field     'local field structure
  Dim tbln As String     'table name

  'fill the field structure
  f.Name = cFieldName
  'get field length from form for string and memo
  If gwFldType = FT_STRING Then
    gwFldSize = Val(cFieldLength)
  End If
  f.Type = gwFldType
  f.Size = gwFldSize
  If cFieldType = "Counter" Then
    f.Attributes = &H10   'counter type
  End If

  tbln = fTables.cTableList
  If gfAddTableFlag = False Then
    gCurrentDB.TableDefs(tbln).Fields.Append f
  End If
  fTblStru.cFields.Row = 1
  fTblStru.cFields.Col = 0
  If fTblStru.cFields <> "" Then
    'add a row if the first one isn't blank
    fTblStru.cFields.Rows = fTblStru.cFields.Rows + 1
  End If
  fTblStru.cFields.Row = fTblStru.cFields.Rows - 1
  fTblStru.cFields.Col = 0
  fTblStru.cFields = cFieldName
  fTblStru.cFields.Col = 1
  fTblStru.cFields = cFieldType
  fTblStru.cFields.Col = 2
  fTblStru.cFields = cFieldLength
  If fTblStru.cFields.Rows < 12 Then
    fTblStru.cFields.Height = fTblStru.cFields.Rows * 245
    fTblStru.FieldBox.Height = fTblStru.cFields.Height + 360
    fTblStru.IndexBox.Top = fTblStru.FieldBox.Top + fTblStru.FieldBox.Height + 250
    fTblStru.Height = fTblStru.IndexBox.Top + fTblStru.IndexBox.Height + 500
  End If

  'clear the name and allow entry of another
  cFieldName = ""
  cFieldName.SetFocus
  GoTo OkayEnd

OkayErr:
  ShowError
  Resume OkayEnd

OkayEnd:

End Sub